home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / PASCAL / 0391B.ZIP / PTOOLWIN.ARC / PTOOLWIN.PAS < prev   
Pascal/Delphi Source File  |  1985-09-24  |  6KB  |  159 lines
  1. Program PTOOLWIN;  {Copyright  R D Ostrander
  2.                                Ostrander Data Services
  3.                                5437 Honey Manor Dr
  4.                                Indianapolis  IN  46241
  5.  
  6.      This is a demonstration program for the Turbo Pascal subroutine PTOOLWIN
  7.      for window manipulations. Address any questions to the author at the
  8.      above address.                                                          }
  9.  
  10.  
  11. {$I PTOOLWIN.INC}  {Include statement for PTOOLWIN functions and parameters }
  12.  
  13. VAR
  14.  
  15.    ScreenType, Ans : Char;
  16.  
  17. { Constant Values (Parameters) That must be included in your source program }
  18.  
  19. CONST
  20.  
  21.    PTOOLWIN_Number_of_Windows = 10;    { This determines the number of      }
  22.                                        { windows that may be set with the   }
  23.                                        { PTWSet procedure.                  }
  24.  
  25.    PTOOLWIN_Max_Number_Open = 10;      { This determines the number of      }
  26.                                        { windows that may be open at any    }
  27.                                        { one time. 4K bytes are reserved    }
  28.                                        { each window.                       }
  29.  
  30.    PTOOLWIN_Screen_Type : Char = 'C';  { This must be a 'C' if the program  }
  31.                                        { is to be run on a system with a    }
  32.                                        { Color/Graphics card and must be a  }
  33.                                        { 'M' if the program is to be run on }
  34.                                        { a system with a Monochrome card or }
  35.                                        { on an IBM-3270-PC.                 }
  36.  
  37.  
  38. { Internal Routines Begin Here ****************************** }
  39.  
  40.  
  41. Procedure NewScreen;
  42.  
  43. Var
  44.    Screen, Code : Integer;
  45.  
  46. Begin
  47.      Val (Ans, Screen, Code);
  48.      If (Code = 0) and
  49.         (Screen in [1..9]) then
  50.         If PTOOLWIN_Stack_Size = 9 then
  51.            Begin
  52.                 PTWOpen (10);
  53.                 ClrScr;
  54.                 Gotoxy (20,1);
  55.                 Write ('This demonstration program only allows 9 windows.');
  56.                 Gotoxy (20,3);
  57.                 Write ('I will now close the previous window');
  58.                 Delay (3000);
  59.                 PTWClose;
  60.                 PTWClose;
  61.            End
  62.         else
  63.            Begin
  64.                 PTWOpen (Screen);
  65.                 ClrScr;
  66.            End;
  67. End;
  68.  
  69.  
  70. { Main Program Begins Here ********************************** }
  71.  
  72.  
  73. BEGIN
  74.  
  75.  ClrScr;
  76.  Gotoxy (15,7); Write ('Demonstration of PTOOLWIN procedure.');
  77.  Gotoxy (15,9); Write ('PTOOLWIN and this program are copyrights');
  78.  Gotoxy (15,10); Write ('of R D Ostrander');
  79.  Gotoxy (15,11); Write ('   Ostrander Data Services');
  80.  Gotoxy (15,12); Write ('   5437 Honey Manor Dr');
  81.  Gotoxy (15,13); Write ('   Indianapolis  IN  46241');
  82.  Gotoxy (15,14); Write ('and have been placed in the public domain.');
  83.  
  84.  ScreenType := ' ';
  85.  Ans        := ' ';
  86.  
  87.  Gotoxy (10,19);
  88.  Write ('Are you using a Monochrome card or Color/Graphics card ? (M/C)');
  89.  Gotoxy (10,20);
  90.  Write ('Compaq uses a Color/Graphics - 3270/PC uses Monochrome!       ');
  91.  While not (Ans in ['M', 'C']) do
  92.        Begin
  93.             Read (KBD, Ans);
  94.             Write (Ans);
  95.             Ans := UpCase (Ans);
  96.        End;
  97.  PTOOLWIN_Screen_Type := Ans;
  98.  Ans := ' ';
  99.  
  100.  Gotoxy (10,23);
  101.  Write ('Would you like to have this program run in Color? (Y/N)');
  102.  Gotoxy (10,24);
  103.  Write ('Some Monochrome cards will show shades of grey.        ');
  104.  While not (ScreenType in ['Y', 'N']) do
  105.        Begin
  106.             Read (KBD, ScreenType);
  107.             Write (ScreenType);
  108.             ScreenType := UpCase (ScreenType);
  109.        End;
  110.  
  111.  If ScreenType = 'Y' then
  112.     Begin
  113.          PTWSet (1, 2, 3, 31, 9, 1, 0, 15);
  114.          PTWSet (2, 7, 4, 73, 21, 2, 1, 14);
  115.          PTWSet (3, 40, 1, 80, 25, 0, 2, 13);
  116.          PTWSet (4, 1, 8, 80, 16, -1, 3, 12);
  117.          PTWSet (5, 8, 12, 55, 24, -2, 4, 7);
  118.          PTWSet (6, 1, 10, 45, 20, 1, 5, 12);
  119.          PTWSet (7, 5, 5, 75, 10, 2, 6, 9);
  120.          PTWSet (8, 40, 11, 70, 24, 0, 15, 0);
  121.          PTWSet (9, 1, 1, 80, 25, -2, 1, 10);
  122.          PTWSet (10, 1, 21, 80, 25, -2, 4, 0);
  123.     End
  124.  else
  125.     Begin
  126.          PTWSet (1, 2, 3, 31, 9, 0, 15, 0);
  127.          PTWSet (2, 7, 4, 73, 21, 1, 0, 15);
  128.          PTWSet (3, 40, 1, 80, 25, 2, 0, 15);
  129.          PTWSet (4, 1, 8, 80, 16, -1, 0, 15);
  130.          PTWSet (5, 8, 12, 55, 24, -2, 0, 15);
  131.          PTWSet (6, 1, 10, 45, 20, 1, 15, 0);
  132.          PTWSet (7, 5, 5, 75, 10, 2, 0, 15);
  133.          PTWSet (8, 40, 11, 70, 24, -1, 0, 15);
  134.          PTWSet (9, 1, 1, 80, 25, -2, 0, 15);
  135.          PTWSet (10, 1, 21, 80, 25, 2, 15, 0);
  136.     End;
  137.  
  138.  While Ans <> 'E'do
  139.        Begin
  140.             If Ans <> 'C' then
  141.                Begin
  142.                     Gotoxy (2,2); Write ('Pick a screen - 1 to 9');
  143.                     Gotoxy (2,3); Write (' or "C" to close a screen');
  144.                     Gotoxy (2,4); Write (' or "E" to End           ');
  145.                End;
  146.             Read (KBD, Ans);
  147.             Write (Ans); Gotoxy (WhereX - 1, WhereY);
  148.             Ans := UpCase (Ans);
  149.             If (Ans = 'C') and (PTOOLWIN_Stack_Size > 0) then PTWClose;
  150.             If Ans in ['1'..'9'] then NewScreen;
  151.        End;
  152.  
  153. Window (1,1,80,25);
  154. ClrScr;
  155. Gotoxy (1,24);
  156. TextColor(0);
  157. TextBackground (15);
  158.  
  159. END.